﻿Imports System.Reflection
Imports System.Reflection.Emit
Imports System.Threading

Public Class Sentinel

    Private Shared _sentinels As New Dictionary(Of String, Object)
    Private Shared _sentinelsLock As New Object

    Public Shared Function GetSentinel(Of T)() As T
        Dim typeOfT = GetType(T)
        Dim typeName = GetType(T).FullName
        If Not typeOfT.IsInterface Then
            Trace.Fail(String.Format("{0} is not an interface", typeName))
            Return Nothing
        End If

        SyncLock _sentinelsLock
            Try
                Return CType(_sentinels(typeName), T)
            Catch ex As KeyNotFoundException
                Dim newSentinel = CreateSentinel(Of T)(Assembly.GetCallingAssembly())
                _sentinels(typeName) = newSentinel
                Return newSentinel
            End Try
        End SyncLock
    End Function

    Private Shared Function CreateSentinel(Of T)(ByVal callingAssembly As Assembly) As T
        'in calling assembly:
        Dim typeOfT = GetType(T)
        Dim types = callingAssembly.GetTypes
        Dim foundType As Type = Nothing

        'look for class that implements T and is marked as IsSentinelImpl
        For Each t In types
            Dim ifs = t.GetInterfaces
            For Each i In ifs
                If i Is typeOfT Then
                    Dim attributes = t.GetCustomAttributes(GetType(IsSentinelImplAttribute), False)
                    If attributes.Length > 0 Then
                        Dim sentinelType = DirectCast(attributes(0), IsSentinelImplAttribute).SentinelType
                        If sentinelType Is typeOfT Then
                            foundType = t
                            Exit For
                        End If
                    End If
                End If
            Next
            If foundType IsNot Nothing Then Exit For
        Next

        'if not found look for class that implements T and is named SentinelImplT
        If foundType Is Nothing Then
            For Each t In types
                If t.Name = "SentinelImpl" + typeOfT.Name Then
                    Dim ifs = t.GetInterfaces
                    For Each i In ifs
                        If i Is typeOfT Then
                            foundType = t
                            Exit For
                        End If
                    Next
                    If foundType Is Nothing Then
                        Trace.TraceWarning(String.Format("Found sentinel implementation class for {0}, but {1} does not implement interface {0}", _
                                                         typeOfT.Name, t.Name))
                    End If
                End If
            Next
        End If

        'if not found generate sentinel in memory
        If foundType Is Nothing Then
            foundType = GenerateSentinelImplType(Of T)()
        End If

        If foundType IsNot Nothing Then
            Dim ci = foundType.GetConstructor(Type.EmptyTypes)
            Return (DirectCast(ci.Invoke(Nothing), T))
        End If

    End Function

    Private Shared Function GenerateSentinelImplType(Of T)() As Type
        Dim typeOfT = GetType(T)
        Try
            Dim assemblyName = New AssemblyName("DynamicSentinelsAssembly")
            Dim assemblyBuilder = Thread.GetDomain().DefineDynamicAssembly(assemblyName, AssemblyBuilderAccess.Run)
            Dim moduleBuilder = assemblyBuilder.DefineDynamicModule("DynamicSentinelsModule")
            Dim interfaces() As Type = {typeOfT}
            Dim sentinelImplTypeName = "SentinelImpl" + typeOfT.Name
            Dim tb = moduleBuilder.DefineType(sentinelImplTypeName, _
                                                       TypeAttributes.Public, _
                                                       GetType(Object), interfaces)

            For Each prop In typeOfT.GetProperties()
                AddProperty(Of T)(tb, prop)
            Next

            For Each m In typeOfT.GetMethods()
                If Not m.IsSpecialName Then
                    AddMethod(Of T)(tb, m)
                End If
            Next
            Return tb.CreateType()

        Catch ex As Exception
            Dim msg = String.Format("Could not generate SentinelImpl for {0}", typeOfT.Name)
            Trace.Fail(msg, ex.Message)
            Return Nothing
        End Try
    End Function

    Private Shared Sub AddProperty(Of T)(ByVal tb As TypeBuilder, ByVal prop As PropertyInfo)
        Dim typeOfT = GetType(T)
        Dim propPropertyBuilder = tb.DefineProperty(prop.Name, prop.Attributes, prop.PropertyType, Nothing)
        Dim propField = tb.DefineField("_" + prop.Name, prop.PropertyType, FieldAttributes.Private)
        Dim getSetAttr = MethodAttributes.Public Or MethodAttributes.Virtual Or MethodAttributes.SpecialName Or MethodAttributes.HideBySig
        Dim propGetMethodBuilder = tb.DefineMethod( _
            "get_" + prop.Name, _
            getSetAttr, _
            prop.PropertyType, _
            Type.EmptyTypes)

        Dim propGetIL = propGetMethodBuilder.GetILGenerator()
        propGetIL.Emit(OpCodes.Ldarg_0)
        propGetIL.Emit(OpCodes.Ldfld, propField)
        propGetIL.Emit(OpCodes.Ret)

        Dim propGetMethodInfo = typeOfT.GetMethod("get_" + prop.Name)
        tb.DefineMethodOverride(propGetMethodBuilder, propGetMethodInfo)

        Dim propSetMethodBuilder = tb.DefineMethod( _
                "set_" + prop.Name, _
                getSetAttr, _
                Nothing, _
                New Type() {prop.PropertyType})

        Dim propSetIL = propSetMethodBuilder.GetILGenerator()
        propSetIL.Emit(OpCodes.Ldarg_0)
        propSetIL.Emit(OpCodes.Ldarg_1)
        propSetIL.Emit(OpCodes.Stfld, propField)
        propSetIL.Emit(OpCodes.Ret)

        Dim propSetMethodInfo = typeOfT.GetMethod("set_" + prop.Name)
        tb.DefineMethodOverride(propSetMethodBuilder, propSetMethodInfo)

        propPropertyBuilder.SetGetMethod(propGetMethodBuilder)
        propPropertyBuilder.SetSetMethod(propSetMethodBuilder)
    End Sub

    Private Shared Sub AddMethod(Of T)(ByVal tb As TypeBuilder, ByVal m As MethodInfo)
        Dim typeOfT = GetType(T)
        Dim paramTypes As New List(Of Type)
        For Each param In m.GetParameters()
            paramTypes.Add(param.ParameterType)
        Next
        Dim mMethodBuilder = tb.DefineMethod(m.Name, MethodAttributes.Public Or MethodAttributes.Virtual, m.CallingConvention, m.ReturnType, paramTypes.ToArray())

        Dim mIL = mMethodBuilder.GetILGenerator()
        mIL.Emit(OpCodes.Ret)

        Dim mMethodInfo = typeOfT.GetMethod(m.Name)
        tb.DefineMethodOverride(mMethodBuilder, mMethodInfo)
    End Sub

End Class